home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / forst.zoo / forst / src / heads.s < prev    next >
Encoding:
Text File  |  1990-12-10  |  9.0 KB  |  306 lines
  1. ; HEADS.S: low-level access words for headers
  2. ; and their handlers.
  3. ; Copyright <c> John Redmond, 1989,1990
  4. ; Public domain for non-commercial use.
  5. ;
  6.         section text
  7.         even
  8. ;
  9. lensize = 2
  10. macspecs = 4                    ;2 words after name
  11. pointers = 8                    ;2 fields
  12. overmacs = macspecs+1
  13. threeflds = macspecs+pointers
  14. allflds = threeflds+lensize
  15. nxtnfa = pointers+lensize
  16. frstcfa = nxtnfa
  17.  
  18. ; _BFIND: The pointer to string is expected on the stack.
  19. ; If a match is found, the code field address is returned
  20. ; with +1 or -1, otherwise the string pointer is returned with 0.
  21. _bfind: movem.l a2-a4,-(a7)
  22.         bsr     upper           ;string in pocket to upper case
  23.         bsr     _top            ;normally equivalent to _there
  24.         pop     a0              ;pointer to headers
  25.         pop     a4              ;address of pocket
  26. .bflp:
  27. ;point to name in next header
  28.         move.w  -(a0),d0
  29.         beq     .notfnd         ;zero if already at last header
  30.         suba.w  d0,a0           ;point to previous header
  31.         move.l  a0,a2           ;working copy of pointer
  32. ;try for a match
  33.         move.l  a4,a1           ;pointer to match string
  34.         move.b  (a2)+,d0
  35.         and.l   #$3f,d0         ;mask off name length & leave smudge bit
  36.         cmp.b   (a1)+,d0
  37.         bne     .bflp           ;length is wrong
  38.         subq.l  #1,d0
  39. .matchlp: move.b (a2)+,d1
  40.         and.b   #$7f,d1         ;mask off high bit
  41.         cmp.b   (a1)+,d1
  42.         bne     .bflp           ;character mismatch
  43.         dbra    d0,.matchlp
  44.         move.w  a2,d0
  45.         btst    #0,d0
  46.         beq     .match9         ;if address is even
  47.         addq.l  #1,a2
  48. .match9: addq.l #4,a2           ;skip length and macro flag
  49.         push    a2              ;cfa of word
  50.         move.l  #-1,d0          ;return -1
  51.         btst    #6,(a0)         ;test immediate bit
  52.         beq     .notimm
  53.         neg.l   d0              ;return +1
  54. .notimm: push   d0              ;true flag
  55.         bra     .fx
  56. .notfnd: push   a4              ;return pocket address
  57.         clr.l   -(a6)           ;with false flag
  58. .fx:    movem.l (a7)+,a2-a4
  59.         rts
  60. ;
  61. _traverse: movem.l (a6)+,d0/a0
  62. .trlp:  add.l   d0,a0
  63.         btst    #7,(a0)
  64.         beq     .trlp
  65.         push    a0
  66.         rts
  67. ;
  68. _cton:  pop     a0
  69.         subq.l  #overmacs,a0
  70.         push    a0
  71.         push    #-1
  72.         bsr     _traverse       ;get nfa
  73.         rts
  74. ;
  75. _ntoc:  push    #1
  76.         bsr     _traverse
  77.         add.l   #overmacs,(a6)
  78.         rts
  79. ;
  80. codehead: move.l (a0),d0        ;get code offset
  81.         lea     _const,a1
  82.         suba.l  a5,a1           ;code offset of constant
  83.         cmp.l   a1,d0
  84.         bne     .cy             ;not a constant header
  85.         adda.l  #nxtnfa,a0      ;nfa of next header
  86.         lea     hp,a1
  87.         move.l  (a1),d0
  88.         add.l   a5,d0
  89.         cmp.l   a0,d0
  90.         bls     .cx             ;no more headers
  91.         push    a0
  92.         bsr     _ntoc
  93.         pop     a0              ;cfa of next header
  94.         bra     codehead        ;try again
  95. .cx:    move.l  #0,a0           ;set zero flag
  96. .cy:    rts
  97. ;
  98. discard: move.l (a6),a0
  99.         bsr     codehead        ;get a header with its own code
  100.         beq     .d5             ;no code to delete
  101.         lea     cp,a1
  102.         move.l  4(a0),(a1)      ;correct code pointer
  103. .d5:    bsr     _cton
  104.         pop     d0              ;nfa of original header
  105.         lea     entry,a0
  106.         move.l  d0,(a0)         ;entry for find
  107.         sub.l   a5,d0           ;subtract index to get offset
  108.         lea     hp,a0
  109.         move.l  d0,(a0)         ;correct header pointer
  110.         rts
  111. ;
  112. castore: bsr    _there
  113.         pop     a0
  114.         suba.l  #frstcfa,a0     ;point to cfa
  115.         pop     d0
  116.         sub.l   a5,d0           ;code offset
  117.         move.l  d0,(a0)
  118.         rts
  119. ;
  120. do_ptrs:
  121.         suba.l  a5,a0           ;convert to offset
  122.         push    a0
  123.         bsr     _hcomma
  124.         lea     cp,a0
  125.         push    (a0)
  126.         bsr     _hcomma         ;offset ^value in pfa
  127.         rts
  128. ;
  129. header: bsr     name            ;return address of pocket
  130.         bsr     _align
  131.         bsr     _halign
  132.         bsr     _there
  133.         move.l  (a6),-(a7)      ;save copy of nfa
  134.         move.l  4(a6),a0        ;pocket address
  135.         clr.l   d0
  136.         move.b  (a0),d0         ;name length
  137.         addq.l  #1,d0
  138.         push    d0
  139.         move.l  d0,-(a7)        ;save length for later
  140.         bsr     _cmove          ;move name into place
  141.         push    (a7)+           ;length
  142.         bsr     _hallot
  143.         bsr     _halign
  144.         bsr     _there
  145.         pop     a0
  146.         tas     -1(a0)          ;set bit 7 at end of name
  147.         move.l  (a7)+,a0        ;get nfa back
  148.         tas     (a0)            ;set bit 7 of name length
  149.         push    #0
  150.         bsr     _hcomma         ;ready for macro flag and length
  151.         rts
  152. ;       
  153. dolength: lea   pocket,a0       ;add in head length at end of head
  154.         move.l  (a0),a0
  155.         moveq.l #0,d0
  156.         move.b  (a0),d0
  157.         add.w   #(threeflds+1),d0 ;length of dimensioned name + 12
  158.         moveq.l #1,d1
  159.         and.w   d0,d1
  160.         add.w   d1,d0           ;add 1 if length odd
  161.         lea     hp,a0
  162.         move.l  (a0),a1
  163.         add.l   #lensize,(a0)
  164.         adda.l  a5,a1
  165.         move.w  d0,(a1)+        ;store the length in the header
  166.         lea     entry,a0
  167.         move.l  a1,(a0)         ;starting address for FIND
  168.         rts
  169. ;
  170. fndnfa:    lea    entry,a0
  171.     push    (a0)
  172.     sub.l    #15,(a6)
  173.     push    #-1
  174.     bsr    _traverse
  175.     pop    a0
  176.     rts
  177. ;
  178. _immediate: bsr.s fndnfa
  179.         bset    #6,(a0)
  180.         rts
  181. ;
  182. _smudge: bsr.s fndnfa
  183.         eori.b  #$20,(a0)
  184.         rts
  185. ;
  186. _last:  bsr     _top
  187.         sub.l   #15,(a6)
  188.         push    #-1
  189.         bsr     _traverse
  190.         rts
  191. ;
  192. ;*******************************************************;
  193. ;                                                       ;
  194. ; The handlers for the separated headers                ;
  195. ;                                                       ;
  196. ;*******************************************************;
  197. ;
  198. fnfa:   bsr     _head
  199.         sub.l   #overmacs,(a6)
  200.         push    #-1
  201.         bsr     _traverse       ;get nfa
  202.         rts
  203. ;
  204. headlen: moveq.l #0,d0
  205.         move.b  (a0),d0
  206.         and.l   #$1f,d0         ;length of name
  207.         move.l  d0,d1
  208.         and.l   #1,d1
  209.         eor.l   #1,d1
  210.         add.b   d1,d0           ;extra byte if length is even
  211.         add.b   #(allflds+1),d0 ;total length of header (add 1+3*4+2)
  212.         rts
  213. ;
  214. _from:  bsr     fnfa
  215.         pop     a0
  216.         suba.l  a5,a0
  217.         lea     chop,a1
  218.         move.l  a0,(a1)         ;start of header removal
  219.         bsr     _pad
  220.         pop     a0
  221.         lea     hbase,a1
  222.         move.l  a0,(a1)         ;keep selected headers here
  223.         lea     hnow,a1
  224.         move.l  a0,(a1)         ;place for next header
  225.         lea     hlen,a0
  226.         clr.l   (a0)            ;none so far
  227.         rts
  228. ;
  229. _keep:  movem.l a2-a3,-(a7)
  230.         bsr     fnfa
  231.         move.l  (a6),a0         ;copy nfa
  232.         bsr     headlen         ;length in d0
  233.         lea     hlen,a1
  234.         add.l   d0,(a1)         ;increase length of stored headers
  235.         lea     hnow,a2
  236.         move.l  (a2),a3         ;where to move this header
  237.         add.l   d0,(a2)         ;increase store pointer
  238.         push    a3
  239.         push    d0
  240.         bsr     _cmove          ;shift header
  241.         movem.l (a7)+,a2-a3
  242.         rts
  243. ;
  244. _hide:  bsr     fnfa
  245.         pop     a0
  246.         bsr     headlen         ;length in d0
  247.         lea     (a0,d0.l),a1
  248.         push    a1
  249.         push    a0
  250.         lea     hp,a0
  251.         move.l  (a0),d1
  252.         add.l   a5,d1           ;^free header space
  253.         sub.l   d0,(a0)         ;adjust hp back
  254.         sub.l   a1,d1           ;size of header block to move
  255.         push    d1
  256.         bsr     _cmove
  257.         bra.s    pbx
  258. ;
  259. _public: move.l a2,-(a7)
  260.         lea     hp,a0
  261.         lea     chop,a1
  262.         move.l  (a1),(a0)       ;cut headers back
  263.         move.l  (a0),a1
  264.         adda.l  a5,a1           ;dest for header move
  265. ;
  266.         lea     hlen,a2
  267.         move.l  (a2),d0         ;length of saved heads
  268.         add.l   d0,(a0)         ;advance hp
  269. ;
  270.         lea     hbase,a2
  271.         move.l  (a2),a2
  272.         push    a2              ;source
  273.         push    a1              ;dest
  274.         push    d0              ;length
  275.         bsr     _cmove
  276.         move.l  (a7)+,a2        ;restore
  277. pbx:    bsr     _there
  278.         lea     entry,a0
  279.         pop     (a0)            ;start for find
  280.         rts
  281. ;
  282.         section data
  283.         even
  284. ;
  285.         dc.b    $88,'TRAVERSE',$a0
  286.         ptrs    _traverse,22
  287. ;
  288.         dc.b    $84,'LAST',$a0
  289.         ptrs    _last,18
  290. ;
  291.         dc.b    $84,'HEAD',$a0
  292.         ptrs    _head,18
  293. ;
  294.         dc.b    $84,'FROM',$a0
  295.         ptrs    _from,18
  296. ;
  297.         dc.b    $84,'KEEP',$a0
  298.         ptrs    _keep,18
  299. ;
  300.         dc.b    $84,'HIDE',$a0
  301.         ptrs    _hide,18
  302. ;
  303.         dc.b    $86,'PUBLIC',$a0
  304.         ptrs    _public,20
  305. ;
  306.